COMMENT ⊗   VALID 00006 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	BEGIN "INITER"
 00004 00003	SIMPLE PROCEDURE ERROR(VALUE STRING XMESSAGE)
 00006 00004	 FIELD gets the next field of a line, terminating on a space,tab, or line 
 00009 00005	 Put multiple word keys into the dictionary
 00014 00006	MOVE MULTIPLE WORDS UP AND WRITE OUT AND CLOSE FILES
 00017 ENDMK
⊗;
BEGIN "INITER"

DEFINE	CR="'15",
	LF="'12",
	CRLF="(CR&LF)",
	TAB="'11",
	FF="'14",
	SPACE="'40",
	LINE="1",
	FIELD="2",
	MULTMAX="10",
	MINUS1="2↑18 - 1",
	LLEN="'10000",
	MAXNBR="500",
	XSIZE="3",
	SPECS="4",
	XLEN="MAXNBR*XSIZE+SPECS",
	MAXDLEN="'10000",
	WLEN="'6400";
INTEGER ARRAY INDEX[0:XLEN-1];
INTEGER ARRAY DICT[0:MAXDLEN-1];
INTEGER ARRAY WORDS[0:WLEN-1];
INTEGER ARRAY LINKS[0:LLEN-1];
INTEGER FLAG, EOF,BRCHAR,LST,LWD,LEN,I;
STRING KEY,KEY0,KEY1;
LABEL CONT,MULTKEY,TEST;
STRING ARRAY MKEY[2:MULTMAX];
INTEGER BPTR,BWD,MI,LINK;
EXTERNAL INTEGER RPGSW;

DEFINE	TESTOVERLAP = "IF BWD ≤ LWD + 3 THEN ERROR(""MAXDLEN TOO SMALL"")";
SIMPLE PROCEDURE ERROR(VALUE STRING XMESSAGE);
	BEGIN
	OUTSTR("ERROR: "&XMESSAGE&CRLF);
	CALL(0,"EXIT");
	END;

BOOLEAN SIMPLE PROCEDURE AFTER(VALUE STRING A,B);
	BEGIN
	A←A&"@";
	B←B&"@";
	WHILE CVASC(A)=CVASC(B) DO
		BEGIN
		IF EQU(A,NULL) THEN RETURN(FALSE);
		A←A[6 TO ∞];
		B←B[6 TO ∞];
		END;
	RETURN (CVASC(A)>CVASC(B));
	END;

SIMPLE PROCEDURE PUTWORD(STRING KEY1);
	BEGIN
	LEN←LENGTH(KEY1) MIN 19;COMMENT:get the length of KEY1;
	KEY1←KEY1&"@@@@@";
	FOR I←0 STEP 5 UNTIL LEN DO
		BEGIN
		WORDS[LST]←CVASC(KEY1);  COMMENT: store 5 characters in WORDS;
		LST←LST+1;		 COMMENT: increment the pointer;
		KEY1←KEY1[6 TO ∞];	 COMMENT: get the rest of KEY1;
		END;
	END;

SIMPLE PROCEDURE UNDO;
	BEGIN
	RELEASE(4);
	OPEN(5,"DSK",'17,0,0,0,0,0);
	ENTER(5,"INDEX",FLAG);
	WHILE FLAG DO
		BEGIN
		RELEASE(5);
		CALL(1,"SLEEP");
		OPEN(5,"DSK",'17,0,0,0,0,0);
		ENTER(5,"INDEX",FLAG);
		END;
	OPEN(4,"DSK",'17,0,0,0,0,0);
	LOOKUP(4,"INDEX",FLAG);
		IF FLAG THEN ERROR("SECOND LOOKUP FAILED ON INDEX FILE");
	ARRYIN(4,INDEX[0],XLEN);
	RELEASE(4);
	INDEX[0]←INDEX[2];
	FOR I←SPECS STEP 3 UNTIL XLEN-1 DO INDEX[I]←0;
	ARRYOUT(5,INDEX[0],XLEN);
	END;
COMMENT: FIELD gets the next field of a line, terminating on a space,tab, or line 
	feed. LINE inputs an entire line, terminating on a line feed only;
SETBREAK(FIELD,"@"&LF,CR&FF,"INS");
SETBREAK(LINE,LF,NULL,"INS");

OPEN(0,"DSK",'10,0,2,0,0,0);
ENTER(0,"DICT",FLAG);	COMMENT:dictionary file;
	IF FLAG THEN ERROR("ENTER FAILED! ON 'DICT'");
OPEN(1,"DSK",'10,0,2,0,0,0);
ENTER(1,"WORDS",FLAG);	COMMENT: output file of keywords;
	IF FLAG THEN ERROR("ENTER FAILED ON 'WORDS'");
OPEN(2,"DSK",0,2,0,300,BRCHAR,EOF);
LOOKUP(2,"WORDS.SRT",FLAG);COMMENT: input file of keywords;
	IF FLAG THEN ERROR("LOOKUP FAILED ON 'WORDS.SRT'");
OPEN(3,"DSK",'10,0,2,0,0,0);
ENTER(3,"LINKS",FLAG);	COMMENT: LINK file;
	IF FLAG THEN ERROR("ENTER FAILED ON 'LINKS'");
IF ¬RPGSW THEN BEGIN
	OPEN(4,"DSK",'17,0,0,0,0,0);
	LOOKUP(4,"INDEX",FLAG);
	IF ¬FLAG THEN UNDO COMMENT: UNDO USES CHANNEL 5 TO WRITE OUT A NEW INDEX FILE;
		ELSE RELEASE(4);
	END;

FOR I←0 STEP 2 UNTIL LLEN-3 DO LINKS[I]←I+2; COMMENT: this links together all the
	space in LINKS.
LST←0;		COMMENT:pointer into WORDS;
LWD←2;		COMMENT:pointer into DICT;
KEY0←"@";	COMMENT:key for comparison;
BWD←MAXDLEN-3;	COMMENT:ptr to bottom of DICT;

DO KEY1←INPUT(2,FIELD) UNTIL ¬EQU(KEY1,NULL) ∨ EOF; COMMENT: get the first KEY;
WHILE ¬EOF DO                      
	BEGIN
	COMMENT:first we check to see if the KEYS are in order. KEY0 is the last
		key, KEY1 is the present key;
	MI←1;
	IF ¬AFTER(KEY1,KEY0) THEN IF EQU(KEY1,KEY0) THEN
			BEGIN
			LWD←LWD-2;
			GO TO MULTKEY;
			END
		ELSE ERROR("WORDS OUT OF ORDER: "&KEY0&","&KEY1);
	KEY0←KEY1;COMMENT: reset KEY0 for next time;
	FOR I←2 STEP 1 UNTIL MULTMAX DO MKEY[I]←NULL;
	DICT[LWD]←LST*2↑18; COMMENT: put pointer to WORDS in left half of DICT[LWD];
	PUTWORD(KEY1);
	IF BRCHAR="@" THEN DICT[LWD+1]←MINUS1;
COMMENT: Put multiple word keys into the dictionary;

MULTKEY:BPTR←DICT[LWD+1] DIV 2↑18;
	IF BPTR=0 THEN BPTR←LWD;
	WHILE	BRCHAR="@" DO
		BEGIN
		MI←MI+1;
		KEY←INPUT(2,FIELD);
		LINK←DICT[BPTR+2] LAND '777777;
		WHILE LINK≠0 DO
			BEGIN
			BPTR←LINK;
			LINK←DICT[BPTR+2] LAND '777777;
			END;
		IF EQU(KEY,MKEY[MI]) THEN
			IF (LINK←DICT[BPTR+1] DIV 2↑18)≠0 THEN BPTR←LINK ELSE
		ELSE	BEGIN
			IF EQU(MKEY[MI],NULL) THEN DICT[BPTR+1]←BWD*2↑18+DICT[BPTR+1]
			ELSE DICT[BPTR+2]←BWD+DICT[BPTR+2];
			MKEY[MI]←KEY;
			DICT[BWD]←LST*2↑18;
			DICT[BWD+2]←BPTR*2↑18;
			PUTWORD(KEY);
			BPTR←BWD;
			BWD←BWD-3;
			TESTOVERLAP;
			WHILE BRCHAR="@" DO
				BEGIN
				MI←MI+1;
				MKEY[MI]←KEY←INPUT(2,FIELD);
				DICT[BWD]←LST*2↑18;
				DICT[BWD+2]←BPTR*2↑18;
				DICT[BPTR+1]←BWD*2↑18 + MINUS1;
				PUTWORD(KEY);
				BPTR←BWD;
				BWD←BWD-3;
				TESTOVERLAP;
				END;
			END;
		END;
	FOR I←MI+1 STEP 1 UNTIL MULTMAX DO MKEY[I]←NULL;
	LWD←LWD+2;	COMMENT:DICT entries are 2 words long;
	TESTOVERLAP;
	IF BRCHAR≠LF THEN INPUT(2,LINE); COMMENT: this gets rid of everything up to
						  the next desirable FIELD;
	DO KEY1←INPUT(2,FIELD) UNTIL ¬EQU(KEY1,NULL) ∨ EOF; COMMENT: get the next KEY1;
	END;
RELEASE(2);
DICT[LWD]←LST*2↑18;
WORDS[LST]←CVASC("?");		COMMENT:  make last word in DICT beyond all possible words;
LST←LST+1;
COMMENT MOVE MULTIPLE WORDS UP AND WRITE OUT AND CLOSE FILES;

IF LWD LAND '777777777600 ≠ 0 THEN
	LWD←(LWD LAND '777777777600) + 128;
TESTOVERLAP;

BWD←BWD+3;
WHILE BWD<MAXDLEN DO
	BEGIN
TEST:	IF LWD MOD 128 ≥ 126 THEN LWD ← LWD + 2;
	LINK←DICT[BWD+2] DIV 2↑18;
	IF DICT[LINK+1] DIV 2↑18=BWD
		THEN DICT[LINK+1]←LWD*2↑18 + (DICT[LINK+1] LAND '777777)
		ELSE DICT[LINK+2]←LWD + (DICT[LINK+2] LAND '777777000000);
	LINK←DICT[BWD+1] DIV 2↑18;
	IF LINK≠0 THEN DICT[LINK+2]←LWD*2↑18 + (DICT[LINK+2] LAND '777777);
	LINK←DICT[BWD+2] LAND '777777;
	IF LINK≠0 THEN DICT[LINK+2]←LWD*2↑18 + (DICT[LINK+2] LAND '777777);
	DICT[LWD]←DICT[BWD];
	DICT[LWD+1]←DICT[BWD+1];
	DICT[LWD+2]←DICT[BWD+2];
	LWD←LWD+3;
	BWD←BWD+3;
	END;

WHILE LWD LAND '177 ≠ 0 DO 
	BEGIN	
	DICT[LWD]←0;
	LWD←LWD+1;
	END;

ARRYOUT(0,DICT[0],LWD);
ARRYOUT(1,WORDS[0],WLEN);
ARRYOUT(3,LINKS[0],LLEN);
OPEN(6,"DSK",0,0,0,0,0,0);
LOOKUP(6,"OCCUR.DAT",FLAG);
IF ¬FLAG THEN RENAME(6,NULL,0,0);
RELEASE(6);
RELEASE(0);
RELEASE(1);
RELEASE(3);
RELEASE(5);

END "INITER"